home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / ovrsub.com / OVRSUB.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1990-01-04  |  5.2 KB  |  199 lines

  1. {
  2. OVRSUB
  3. Written by Ron Schuster
  4. Copyright (c) 1989.  All rights reserved.
  5. May be distributed freely, but not for a profit.
  6.  
  7. See OVRSUB.DOC for complete documentation.
  8.  
  9. Version 1.0, 12/28/89
  10. --------------------
  11.   Initial release.
  12. }
  13.  
  14. {$R-,S-,I-,O-,B-,F-}
  15. unit OvrSub;
  16.  
  17. interface
  18. uses Overlay, Dos;
  19.  
  20. function OvrSubstitute (CheckOverlayInfo, CheckEntryPts,
  21.                         CheckStaticSegs, CheckDataSeg : Boolean) : Word;
  22. function OvrClose : Word;
  23.  
  24. implementation
  25.  
  26. {$I OVRSUB.INC}
  27.  
  28. function MoveFilePointer (Handle : Word; Method : Byte; Offset : LongInt) : Word;
  29.   {-Move the file pointer of a file, given only its handle}
  30. {Method: 0=absolute byte offset from beginning of file
  31.          1=byte offset from current location
  32.          2=byte offset from end of file}
  33. var
  34.   Regs : Registers;
  35. begin
  36.   with Regs do begin
  37.     AH := $42;
  38.     AL := Method;
  39.     BX := Handle;
  40.     CX := Long(Offset).HighWord;
  41.     DX := Long(Offset).LowWord;
  42.     MsDos(Regs);
  43.     if Flags and CarryFlagMask = 0 then
  44.       MoveFilePointer := 0
  45.     else
  46.       MoveFilePointer := AX;
  47.   end;
  48. end;
  49.  
  50. function ReadFile (Handle : Word; var Buf; Count : Word; var Result : Word) : Word;
  51.   {-Read a block from a file, given only its handle}
  52. var
  53.   Regs : Registers;
  54. begin
  55.   with Regs do begin
  56.     AH := $3F;
  57.     BX := Handle;
  58.     CX := Count;
  59.     DS := Seg(Buf);
  60.     DX := Ofs(Buf);
  61.     MsDos(Regs);
  62.     if Flags and CarryFlagMask = 0 then begin
  63.       ReadFile := 0;
  64.       Result := AX;
  65.     end
  66.     else
  67.       ReadFile := AX;
  68.   end;
  69. end;
  70.  
  71. function CloseFile (Handle : Word) : Word;
  72.   {-Close a file, given only its handle}
  73. var
  74.   Regs : Registers;
  75. begin
  76.   with Regs do begin
  77.     AH := $3E;
  78.     BX := Handle;
  79.     MsDos(Regs);
  80.     if Flags and CarryFlagMask = 0 then
  81.       CloseFile := 0
  82.     else
  83.       CloseFile := AX;
  84.   end;
  85. end;
  86.  
  87. function BlkRead(var F : word; var Buffer; Size : Word) : Boolean;
  88.   {-Convenient shell around ReadFile}
  89. var
  90.   IoResult, BytesRead : Word;
  91. begin
  92.   IoResult := ReadFile(F, Buffer, Size, BytesRead);
  93.   BlkRead := (IoResult = 0) and (BytesRead = Size);
  94. end;
  95.  
  96. function OvrSubstitute (CheckOverlayInfo, CheckEntryPts,
  97.                         CheckStaticSegs, CheckDataSeg : Boolean) : Word;
  98.   {-Read OVRPREP data from OVR file and adjust static dispatchers in memory}
  99. var
  100.   P : Word;
  101.   File_Ofs : LongInt;
  102.   Static_Seg,
  103.   Code_Size,
  104.   Fixup_Size,
  105.   Entry_Pts,
  106.   TWord : Word;
  107.   I : Integer;
  108. begin
  109.   {Make sure overlay manager is initialized}
  110.   OvrSubstitute := 1;
  111.   if OvrDosHandle = 0 then exit;
  112.  
  113.   {Make sure no overlaid units are loaded}
  114.   OvrSubstitute := 2;
  115.   if OvrLoadList <> 0 then exit;
  116.  
  117.   {Read the trailer from the end of the OVR file}
  118.   OvrSubstitute := 3;
  119.   if MoveFilePointer (OvrDosHandle, 2, -SizeOf(Trailer)) <> 0 then exit;
  120.   if not BlkRead (OvrDosHandle, Trailer, SizeOf(Trailer)) then exit;
  121.  
  122.   {Check if the signature is there}
  123.   if Trailer.Sig <> OvrSubSignature then begin
  124.     if CheckOverlayInfo then
  125.       OvrSubstitute := 4
  126.     else
  127.       OvrSubstitute := 0;
  128.     exit;
  129.   end;
  130.  
  131.   {Move file pointer to beginning of overlay info}
  132.   OvrSubstitute := 3;
  133.   if MoveFilePointer (OvrDosHandle, 0, Trailer.OldFileSize) <> 0 then exit;
  134.  
  135.   P := System.OvrCodeList;
  136.   while P <> 0 do begin
  137.     if not BlkRead (OvrDosHandle, Static_Seg, SizeOf(Static_Seg)) then exit;
  138.     if CheckStaticSegs and (P <> Static_Seg) then begin
  139.       OvrSubstitute := 5;
  140.       exit;
  141.     end;
  142.     if not BlkRead (OvrDosHandle, File_Ofs, SizeOf(File_Ofs)) then exit;
  143.     if not BlkRead (OvrDosHandle, Code_Size, SizeOf(Code_Size)) then exit;
  144.     if not BlkRead (OvrDosHandle, Fixup_Size, SizeOf(Fixup_Size)) then exit;
  145.     if not BlkRead (OvrDosHandle, Entry_Pts, SizeOf(Entry_Pts)) then exit;
  146.     with StaticDispatcher (Ptr(P+PrefixSeg+$10,0)^) do begin
  147.       FileOfs := File_Ofs;
  148.       CodeSize := Code_Size;
  149.       FixupSize := Fixup_Size;
  150.       if CheckEntryPts and (EntryPts <> Entry_Pts) then begin
  151.         OvrSubstitute := 6;
  152.         exit;
  153.       end;
  154.       for I := 1 to Entry_Pts do
  155.         if I <= EntryPts then begin
  156.           if not BlkRead (OvrDosHandle, Vectors[I].CodeOffset, SizeOf(Word))
  157.             then exit;
  158.         end
  159.         else
  160.           if not BlkRead (OvrDosHandle, TWord, SizeOf(TWord)) then exit;
  161.  
  162.       P := CodeListNext;
  163.     end;
  164.   end;
  165.  
  166.   {Get Data Segment Address and compare}
  167.   OvrSubstitute := 7;
  168.   if not BlkRead (OvrDosHandle, Static_Seg, SizeOf(Static_Seg)) then exit;
  169.   if CheckDataSeg and (DSeg <> Static_Seg + PrefixSeg + $10) then exit;
  170.  
  171.   {Get new value for initial overlay buffer size}
  172.   OvrSubstitute := 3;
  173.   if not BlkRead (OvrDosHandle, OvrHeapSize, SizeOf(OvrHeapSize)) then exit;
  174.   OvrSubstitute := 8;
  175.   OvrSetBuf (LongInt(OvrHeapSize) shl 4);
  176.   if OvrResult <> 0 then exit;
  177.  
  178.   {Make sure we're at end of file}
  179.   OvrSubstitute := 3;
  180.   if not BlkRead (OvrDosHandle, Trailer, SizeOf(Trailer)) then exit;
  181.   if Trailer.Sig <> OvrSubSignature then exit;
  182.  
  183.   OvrSubstitute := 0;
  184. end;
  185.  
  186. function OvrClose : Word;
  187.   {-Clear the overlay buffer and close the current overlay file}
  188. begin
  189.   OvrClearBuf;
  190.   if CloseFile(OvrDosHandle) = 0 then begin
  191.     OvrClose := 0;
  192.     OvrDosHandle := 0;
  193.   end
  194.   else
  195.     OvrClose := 1;
  196. end;
  197.  
  198. end.
  199.